Intro

Goal: decide number of pops, maternal families, etc. Then planting design. Parameters: maximize number of pops, then number of maternal families. Plant 2000.

library(tidyverse)
Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
── Attaching packages ──────────────────────────────────────────────────────────────────── tidyverse 1.3.1 ──
✓ ggplot2 3.3.5     ✓ purrr   0.3.4
✓ tibble  3.1.6     ✓ dplyr   1.0.8
✓ tidyr   1.2.0     ✓ stringr 1.4.0
✓ readr   2.1.2     ✓ forcats 0.5.1
── Conflicts ─────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
x dplyr::filter() masks stats::filter()
x dplyr::lag()    masks stats::lag()
library(googlesheets4)
library(ggforce)

is.even <- function(x) x%%2 == 0

get data on pops and families

pops <- read_sheet("https://docs.google.com/spreadsheets/d/1dif9Y5hbkSa56Bgonj04-jXh8jNc6f13RBS6BPUf1IQ",
                   skip=1,
                   na=c("NA", ""),
                   col_types = c("ciiiccccc"),
                   .name_repair = "universal") %>%
  mutate(approx.number.seeds = as.integer(str_remove_all(approx.number.seeds,"[^0-9]")))
✓ Reading from Int Bio parents seed stock.
✓ Range 2:5000000.
New names:
• `parent pop` -> `parent.pop`
• `collection year` -> `collection.year`
• `maternal families` -> `maternal.families`
• `approx number seeds` -> `approx.number.seeds`
• `collection priority?` -> `collection.priority.`
• `on climate PCA?` -> `on.climate.PCA.`
• `JGI DNA` -> `JGI.DNA`
pops

filter to one entry per pop, etc

pops.filtered <- pops %>% group_by(parent.pop) %>% slice_max(order_by=maternal.families) %>%
  filter(approx.number.seeds >= 100) %>%
  filter(!(parent.pop %in% c("HH", "RB"))) # old seed

pops.filtered %>% arrange(maternal.families)
sum(pops.filtered$maternal.families>=8)
[1] 21
sum(pops.filtered$maternal.families>=15)
[1] 18

Scenario 1:

Plant 21 pops * 8 families * 12 reps (= 2016 plants)

Scenario 2:

Plant 11 pops * 15 families * 12 reps (= 1980 plants)

Scenario 3:

3 mfs from WV, 4 mfs WR and 7 mfs from everyone else

total mfs = 3+4+721 = 168 13 reps (= 2002 plants)

planting grid

2000 plants. think of 10 blocks of 200

200 = 4*50

plan 1

Create grid

plants <- 2000
blocks <- 10
columns <- 4
rows <- plants/blocks/columns
size <- 20 # plant diameter
radius <- size/2 
aisle <- 90

plan1 <- expand_grid(block=LETTERS[1:blocks],
                     column=1:columns,
                     row=1:rows,
                     radius=radius)

plan1

add positions

column_offset <- sqrt((2*radius)^2 - radius^2) # Pythagorean theorem for offset spacing
plan1 <- plan1 %>%
  mutate(y_pos=ifelse(is.even(column),
                      row*size,
                      row*size-radius),
         x_pos=ifelse(column==1,
                      radius,
                      radius+(column-1)*column_offset))
plan1
plan1 %>% #filter(block=="A", row <6) %>%
  ggplot(aes(x0=x_pos, y0=y_pos, r=radius)) +
  geom_circle(fill="lightgreen", alpha=.25) + 
  coord_equal() +
  facet_wrap(~block, ncol = 10)

update to position blocks

# only offset x_positions (1 "row" of blocks)
plan1 <- plan1 %>%
  mutate(block_x_offset = as.integer(as.factor(block))-1,
    block_x_offset = block_x_offset* (aisle + size + (columns-1)*column_offset))

plan1 %>% #filter(block=="A", row <6) %>%
  ggplot(aes(x0=x_pos+block_x_offset, y0=y_pos, r=radius)) +
  geom_circle(fill="lightgreen", alpha=.25) + 
  coord_equal() 

Which pops?

The group decision was to go with scenario 3: “3 mfs from WV, 4 mfs WR and 7 mfs from everyone else”

This is the full (filtered) data sheet.

pops.filtered %>% arrange(parent.pop) %>% write_csv("../output/Pops_for_2022_UCD.csv")
LS0tCnRpdGxlOiAiQ29tbW9uIEdhcmRlbiBEZXNpZ24iCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KCiMjIEludHJvCgpHb2FsOiBkZWNpZGUgbnVtYmVyIG9mIHBvcHMsIG1hdGVybmFsIGZhbWlsaWVzLCBldGMuICBUaGVuIHBsYW50aW5nIGRlc2lnbi4KUGFyYW1ldGVyczogbWF4aW1pemUgbnVtYmVyIG9mIHBvcHMsIHRoZW4gbnVtYmVyIG9mIG1hdGVybmFsIGZhbWlsaWVzLiAgUGxhbnQgMjAwMC4KCmBgYHtyfQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeShnb29nbGVzaGVldHM0KQpsaWJyYXJ5KGdnZm9yY2UpCgppcy5ldmVuIDwtIGZ1bmN0aW9uKHgpIHglJTIgPT0gMApgYGAKCiMjIGdldCBkYXRhIG9uIHBvcHMgYW5kIGZhbWlsaWVzCgpgYGB7cn0KcG9wcyA8LSByZWFkX3NoZWV0KCJodHRwczovL2RvY3MuZ29vZ2xlLmNvbS9zcHJlYWRzaGVldHMvZC8xZGlmOVk1aGJrU2E1NkJnb25qMDQtalhoOGpOYzZmMTNSQlM2QlBVZjFJUSIsCiAgICAgICAgICAgICAgICAgICBza2lwPTEsCiAgICAgICAgICAgICAgICAgICBuYT1jKCJOQSIsICIiKSwKICAgICAgICAgICAgICAgICAgIGNvbF90eXBlcyA9IGMoImNpaWljY2NjYyIpLAogICAgICAgICAgICAgICAgICAgLm5hbWVfcmVwYWlyID0gInVuaXZlcnNhbCIpICU+JQogIG11dGF0ZShhcHByb3gubnVtYmVyLnNlZWRzID0gYXMuaW50ZWdlcihzdHJfcmVtb3ZlX2FsbChhcHByb3gubnVtYmVyLnNlZWRzLCJbXjAtOV0iKSkpCgpwb3BzCmBgYAojIyBmaWx0ZXIgdG8gb25lIGVudHJ5IHBlciBwb3AsIGV0YwoKYGBge3J9CnBvcHMuZmlsdGVyZWQgPC0gcG9wcyAlPiUgZ3JvdXBfYnkocGFyZW50LnBvcCkgJT4lIHNsaWNlX21heChvcmRlcl9ieT1tYXRlcm5hbC5mYW1pbGllcykgJT4lCiAgZmlsdGVyKGFwcHJveC5udW1iZXIuc2VlZHMgPj0gMTAwKSAlPiUKICBmaWx0ZXIoIShwYXJlbnQucG9wICVpbiUgYygiSEgiLCAiUkIiKSkpICMgb2xkIHNlZWQKCnBvcHMuZmlsdGVyZWQgJT4lIGFycmFuZ2UobWF0ZXJuYWwuZmFtaWxpZXMpCmBgYAoKYGBge3J9CnN1bShwb3BzLmZpbHRlcmVkJG1hdGVybmFsLmZhbWlsaWVzPj04KQpgYGAKCmBgYHtyfQpzdW0ocG9wcy5maWx0ZXJlZCRtYXRlcm5hbC5mYW1pbGllcz49MTUpCmBgYAoKIyMjIFNjZW5hcmlvIDE6CgpQbGFudCAyMSBwb3BzICogOCBmYW1pbGllcyAqIDEyIHJlcHMgKD0gMjAxNiBwbGFudHMpCgojIyMgU2NlbmFyaW8gMjoKClBsYW50IDExIHBvcHMgKiAxNSBmYW1pbGllcyAqIDEyIHJlcHMgKD0gMTk4MCBwbGFudHMpCgojIyMgU2NlbmFyaW8gMzoKCjMgbWZzIGZyb20gV1YsIDQgbWZzIFdSIGFuZCA3IG1mcyBmcm9tIGV2ZXJ5b25lIGVsc2UKCnRvdGFsIG1mcyA9IDMrNCs3KjIxID0gMTY4ICogMTMgcmVwcyAoPSAyMDAyIHBsYW50cykKCiMjIHBsYW50aW5nIGdyaWQKCjIwMDAgcGxhbnRzLiAgdGhpbmsgb2YgMTAgYmxvY2tzIG9mIDIwMAoKMjAwID0gNCo1MAoKIyMjIHBsYW4gMQoKQ3JlYXRlIGdyaWQKYGBge3J9CnBsYW50cyA8LSAyMDAwCmJsb2NrcyA8LSAxMApjb2x1bW5zIDwtIDQKcm93cyA8LSBwbGFudHMvYmxvY2tzL2NvbHVtbnMKc2l6ZSA8LSAyMCAjIHBsYW50IGRpYW1ldGVyCnJhZGl1cyA8LSBzaXplLzIgCmFpc2xlIDwtIDkwCgpwbGFuMSA8LSBleHBhbmRfZ3JpZChibG9jaz1MRVRURVJTWzE6YmxvY2tzXSwKICAgICAgICAgICAgICAgICAgICAgY29sdW1uPTE6Y29sdW1ucywKICAgICAgICAgICAgICAgICAgICAgcm93PTE6cm93cywKICAgICAgICAgICAgICAgICAgICAgcmFkaXVzPXJhZGl1cykKCnBsYW4xCmBgYAoKYWRkIHBvc2l0aW9ucwpgYGB7cn0KY29sdW1uX29mZnNldCA8LSBzcXJ0KCgyKnJhZGl1cyleMiAtIHJhZGl1c14yKSAjIFB5dGhhZ29yZWFuIHRoZW9yZW0gZm9yIG9mZnNldCBzcGFjaW5nCnBsYW4xIDwtIHBsYW4xICU+JQogIG11dGF0ZSh5X3Bvcz1pZmVsc2UoaXMuZXZlbihjb2x1bW4pLAogICAgICAgICAgICAgICAgICAgICAgcm93KnNpemUsCiAgICAgICAgICAgICAgICAgICAgICByb3cqc2l6ZS1yYWRpdXMpLAogICAgICAgICB4X3Bvcz1pZmVsc2UoY29sdW1uPT0xLAogICAgICAgICAgICAgICAgICAgICAgcmFkaXVzLAogICAgICAgICAgICAgICAgICAgICAgcmFkaXVzKyhjb2x1bW4tMSkqY29sdW1uX29mZnNldCkpCnBsYW4xCmBgYAoKYGBge3IsIGZpZy53aWR0aD0xMH0KcGxhbjEgJT4lICNmaWx0ZXIoYmxvY2s9PSJBIiwgcm93IDw2KSAlPiUKICBnZ3Bsb3QoYWVzKHgwPXhfcG9zLCB5MD15X3Bvcywgcj1yYWRpdXMpKSArCiAgZ2VvbV9jaXJjbGUoZmlsbD0ibGlnaHRncmVlbiIsIGFscGhhPS4yNSkgKyAKICBjb29yZF9lcXVhbCgpICsKICBmYWNldF93cmFwKH5ibG9jaywgbmNvbCA9IDEwKQoKYGBgCnVwZGF0ZSB0byBwb3NpdGlvbiBibG9ja3MKYGBge3IsIGZpZy53aWR0aD0xMn0KIyBvbmx5IG9mZnNldCB4X3Bvc2l0aW9ucyAoMSAicm93IiBvZiBibG9ja3MpCnBsYW4xIDwtIHBsYW4xICU+JQogIG11dGF0ZShibG9ja194X29mZnNldCA9IGFzLmludGVnZXIoYXMuZmFjdG9yKGJsb2NrKSktMSwKICAgIGJsb2NrX3hfb2Zmc2V0ID0gYmxvY2tfeF9vZmZzZXQqIChhaXNsZSArIHNpemUgKyAoY29sdW1ucy0xKSpjb2x1bW5fb2Zmc2V0KSkKCnBsYW4xICU+JSAjZmlsdGVyKGJsb2NrPT0iQSIsIHJvdyA8NikgJT4lCiAgZ2dwbG90KGFlcyh4MD14X3BvcytibG9ja194X29mZnNldCwgeTA9eV9wb3MsIHI9cmFkaXVzKSkgKwogIGdlb21fY2lyY2xlKGZpbGw9ImxpZ2h0Z3JlZW4iLCBhbHBoYT0uMjUpICsgCiAgY29vcmRfZXF1YWwoKSAKYGBgCgojIyBXaGljaCBwb3BzPwoKVGhlIGdyb3VwIGRlY2lzaW9uIHdhcyB0byBnbyB3aXRoIHNjZW5hcmlvIDM6ICIzIG1mcyBmcm9tIFdWLCA0IG1mcyBXUiBhbmQgNyBtZnMgZnJvbSBldmVyeW9uZSBlbHNlIgoKVGhpcyBpcyB0aGUgZnVsbCAoZmlsdGVyZWQpIGRhdGEgc2hlZXQuCgpgYGB7cn0KcG9wcy5maWx0ZXJlZCAlPiUgYXJyYW5nZShwYXJlbnQucG9wKSAlPiUgd3JpdGVfY3N2KCIuLi9vdXRwdXQvUG9wc19mb3JfMjAyMl9VQ0QuY3N2IikKYGBgCgoKCgoKCgo=